COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	preconditions, trueps, lookups
C00005 00003	(mem B1 batterys)
C00007 ENDMK
C⊗;
preconditions, trueps, lookups
Insist all variables instantiated.

(if (and (mem $b batterys)
	 (port $b 2 $j)
	 (volt-batt $b $v))
    (voltage $j $t $v))

(if (and (mem $b batterys)
	 (port $b 1 $j))
    (voltage $j $t 0))

(constraint (+ $v1 $vd $v2)
  (voltage-drop $j1 $j2 $t $vd) 
  (pressure $j1 $t $v1)
  (pressure $j2 $t $v2))
; Heuristic: try first those junctions which span a single device.

(constraint (= $v1 $v2)
  (mem $x wires)
  (port $x $i $j1) 
  (voltage $j1 $t $v1)
  (port $x $k $j2) 
  (not (= $i $k)) ; not really needed, but keeps this constraint non-trivial [<]
  (voltage $j2 $t $v2)) 

(constraint (= $c1 $c2)
  (or (mem $x resistors)
      (mem $x wires))
  (port $x $i $j1) 
  (current $j1 $t $c1)
  (port $x $k $j2) 
  (not (= $i $k)) ; not really needed, but keeps this constraint non-trivial [<]
  (current $j2 $t $c2)) 

(constraint (* $c $r $vd)
  (port $x $i1 $j1)
  (mem $x resistors) ; needed?
  (port $x $i2 $j2)
  (resistance $x $r)
  (voltage-drop $j1 $j2 $t $vd)
  (current $j1 $t $c))  ; could be j2.

  ; law of conservation
(constraint (= (+ . $curs) 0)
  (mem $j junctions)
  (setof $c (current $j $x $t $c) $curs))

;; Implicit: at a junction, all voltages are equal - as no directionality.

(if (mem $p wires)
    (num-ports $p 2))

(if (mem $p batterys)
    (num-ports $p 2))

(if (mem $p resistors)
    (num-ports $p 2))

current - represents material flowing thru wires...
voltage is like pressure
material flowing...
(mem B1 batterys)
(mem w1 wires)
(mem w2 wires)
(mem r1 resistors)
(mem r2 resistors)

(volt-batt B1 20)

	       (port b1 2 ja) 
(port w1 1 ja) (port w1 2 jb) 
(port r1 1 jb) (port r1 2 jc) 
(port r2 1 jc) (port r2 2 jd) 
(port w2 1 jd) (port w2 2 je) 
(port b1 1 je) 


(defun match-in (p lst)
	; this returns a list of lists, 
	; each of which is lst, plugged for a case where an element
	; of lst unified (matched?) with p
   (do ((x lst (cdr lst))
	(ans nil)
        (al))
       ((null x) ans) 
       (cond ((setq al (unifyp (car x) p))
	      (setq ans (cons (plug al lst) ans)))))

(defun solve (p)
  (cond ((truep p)) ; maybe should be lookup?
	(t (do ((guess (fbs 'pr-lookup `(constraint . |$$|)) (cdr guess))
		( ))
	       ((null guess) ?)
	       (do ((lst (match-in p (cdr (getvar '|$$| (car guess)))) (cdr lst))
		    (alst))
		   ((null lst) ?)
		   (cond ((setq alst (lookups-and1 (car lst)))
			  ; Now for the real work!